home *** CD-ROM | disk | FTP | other *** search
/ Supercompiler 1997 / SUPERCOMPILER97.iso / Delphi 3.0 / DATA.Z / toolwin.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-01-29  |  3.4 KB  |  131 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {                                                       }
  6. {       Copyright (c) 1995,97 Borland International     }
  7. {                                                       }
  8. {*******************************************************}
  9.  
  10. unit ToolWin;
  11.  
  12. {$P+,S-,W-,R-}
  13. {$C PRELOAD}
  14.  
  15. interface
  16.  
  17. uses Windows, Messages, Classes, Controls, Forms;
  18.  
  19. type
  20.  
  21. { TToolWindow }
  22.  
  23.   TToolWindow = class(TWinControl)
  24.   private
  25.     FBorderStyle: TBorderStyle;
  26.     FBorderWidth: Integer;
  27.     FMargin: Integer;
  28.     procedure SetBorderStyle(Value: TBorderStyle);
  29.     procedure SetBorderWidth(Value: Integer);
  30.     procedure WMNCCalcSize(var Message: TWMNCCalcSize); message WM_NCCALCSIZE;
  31.     procedure WMNCPaint(var Message: TMessage); message WM_NCPAINT;
  32.     procedure CMCtl3DChanged(var Message: TMessage); message CM_CTL3DCHANGED;
  33.   protected
  34.     procedure CreateParams(var Params: TCreateParams); override;
  35.   public
  36.     constructor Create(AOwner: TComponent); override;
  37.     property Ctl3D;
  38.     property BorderStyle: TBorderStyle read FBorderStyle write SetBorderStyle default bsSingle;
  39.     property BorderWidth: Integer read FBorderWidth write SetBorderWidth default 0;
  40.   end;
  41.  
  42. implementation
  43.  
  44. { TToolWindow }
  45.  
  46. constructor TToolWindow.Create(AOwner: TComponent);
  47. begin
  48.   inherited Create(AOwner);
  49.   FBorderStyle := bsSingle;
  50. end;
  51.  
  52. procedure TToolWindow.CreateParams(var Params: TCreateParams);
  53. begin
  54.   inherited CreateParams(Params);
  55.   if BorderStyle = bsSingle then
  56.     if Ctl3D then
  57.       FMargin := 2
  58.     else
  59.     begin
  60.       FMargin := 1;
  61.       Params.Style := Params.Style or WS_BORDER;
  62.     end
  63.   else
  64.     FMargin := 0;
  65. end;
  66.  
  67. procedure TToolWindow.SetBorderStyle(Value: TBorderStyle);
  68. begin
  69.   if FBorderStyle <> Value then
  70.   begin
  71.     FBorderStyle := Value;
  72.     RecreateWnd;
  73.   end;
  74. end;
  75.  
  76. procedure TToolWindow.SetBorderWidth(Value: Integer);
  77. begin
  78.   if FBorderWidth <> Value then
  79.   begin
  80.     FBorderWidth := Value;
  81.     RecreateWnd;
  82.   end;
  83. end;
  84.  
  85. procedure TToolWindow.WMNCCalcSize(var Message: TWMNCCalcSize);
  86. begin
  87.   InflateRect(Message.CalcSize_Params.rgrc[0], -(FBorderWidth + FMargin),
  88.     -(FBorderWidth + FMargin));
  89.   inherited;
  90. end;
  91.  
  92. procedure TToolWindow.WMNCPaint(var Message: TMessage);
  93. var
  94.   DC: HDC;
  95.   RC, RW: TRect;
  96. begin
  97.   { Get window DC that is clipped to the non-client area }
  98.   DC := GetWindowDC(Handle);
  99.   try
  100.     Windows.GetClientRect(Handle, RC);
  101.     GetWindowRect(Handle, RW);
  102.     MapWindowPoints(0, Handle, RW, 2);
  103.     OffsetRect(RC, -RW.Left, -RW.Top);
  104.     ExcludeClipRect(DC, RC.Left, RC.Top, RC.Right, RC.Bottom);
  105.     { Draw borders in non-client area }
  106.     OffsetRect(RW, -RW.Left, -RW.Top);
  107.     { Erase background }
  108.     InflateRect(RW, -FMargin, -FMargin);
  109.     FillRect(DC, RW, Brush.Handle);
  110.     InflateRect(RW, FMargin, FMargin);
  111.     if Ctl3D and (BorderStyle = bsSingle) then
  112.     begin
  113.       DrawEdge(DC, RW, EDGE_ETCHED, BF_RECT);
  114.       InflateRect(RW, -FMargin, -FMargin);
  115.     end;
  116.     { Erase parts not drawn }
  117.     IntersectClipRect(DC, RW.Left, RW.Top, RW.Right, RW.Bottom);
  118.   finally
  119.     ReleaseDC(Handle, DC);
  120.   end;
  121.   inherited;
  122. end;
  123.  
  124. procedure TToolWindow.CMCtl3DChanged(var Message: TMessage);
  125. begin
  126.   inherited;
  127.   if FBorderStyle = bsSingle then RecreateWnd;
  128. end;
  129.  
  130. end.
  131.